package Database;

use strict;
use warnings;
use IO::File;
use File::Spec;
use File::Path;
use File::Copy;
use Constants qw( :file );
use Options;

BEGIN {
    use Exporter ();
    our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );

    $VERSION = sprintf( "%d", q$Revision$ =~ m{\d+} );
    @ISA     = qw(Exporter);
    @EXPORT  = qw(&database_file
        &update_database_file
        &get_file_key
        &is_same_path
        &is_different_path
        &split_lines);
    %EXPORT_TAGS = ();
    @EXPORT_OK   = qw();
} ## end BEGIN

our %database_update_cache = ();

sub p_update_database_file($$$$ );

sub database_file(;$ );
sub update_database_file($$;$$ );
sub get_file_key($ );          # Unique key for a file
sub is_same_path($$ );         # Returns true if paths are the same
sub is_different_path($$ );    # Returns true if paths are different
sub split_lines($ );

sub p_update_database_file($$$$ ) {
    my ( $database_name, $contents, $mtime, $verbose_name ) = @_;
    my $database = database_file( $database_name );
    if ( -f $database && -r _ ) {

        # Check if the database has actually changed... if not do not rewrite.
        my $oldfh = new IO::File $database, "r";
        if ( $oldfh ) {
            local $/;
            my $oldcontents = <$oldfh>;
            $oldfh->close;
            undef $oldfh;
            if ( $contents eq $oldcontents ) {
                if ( defined $mtime ) {
                    utime( $mtime, $mtime, $database );
                }
                return;
            } ## end if ( $contents eq $oldcontents)
        } ## end if ( $oldfh )
    } ## end if ( -f $database && -r...)
    my $database_old = database_file( $database_name . "-old" );
    my $database_tmp = database_file( $database_name . "-tmp" );
    rmtree( $database_tmp );
    my $fh = new IO::File $database_tmp, "w";
    return undef unless $fh;
    print $fh $contents;
    return undef unless $fh->close;
    undef $fh;

    if ( -e $database ) {
        rmtree( $database_old );
        if ( -d $database ) {
            rename( $database, $database_old );
        }
        else {
            copy( $database, $database_old );
        }
    } ## end if ( -e $database )
    if ( defined $mtime ) {
        utime( $mtime, $mtime, $database_tmp );
    }
    rename( $database_tmp, $database );
    if ( $opt_output{ "verbose" } ) {
        $verbose_name ||= "database: " . $database;
        warn "Updated database: " . $verbose_name . "\n";
    }
} ## end sub p_update_database_file($$$$ )

my $db_migrate_warn;

sub database_file(;$ ) {
    my $suffix = shift;
    $suffix = "addons" unless defined $suffix;
    my $db_dir = File::Spec->catdir( stage_dir, &FILE_DATABASE );
    mkpath( $db_dir, $opt_output{ "verbose" }, 0777 ) unless -d $db_dir;
    my $file = File::Spec->catfile( $db_dir, $suffix );
    unless ( -e $file ) {
        my $old_file = File::Spec->catfile( stage_dir, &FILE_DATABASE . "." . $suffix );
        if ( -e $old_file ) {
            warn "Migrating database files to: " . $db_dir . "\n" unless $db_migrate_warn;
            $db_migrate_warn = 1;
            rename( $old_file, $file );
        }
    } ## end unless ( -e $file )
    return $file;
} ## end sub database_file(;$ )

sub update_database_file($$;$$ ) {
    my ( $database_name, $contents, $mtime, $verbose_name ) = @_;

    if ( $database_update_cache{ $database_name } ) {
        if ( $opt_output{ "verbose" } ) {
            $verbose_name ||= "database: " . database_file( $database_name );
            warn "Multiple updates for: " . $verbose_name . "\n";
        }
    } ## end if ( $database_update_cache...)

    $database_update_cache{ $database_name } = [ $contents, $mtime, $verbose_name ];
} ## end sub update_database_file($$;$$ )

sub get_file_key($ ) {
    my $name = shift;
    return undef unless defined $name;
    return undef unless -e $name;
    my @info = stat( _ );
    return join( ":", @info[ 0, 1, 2, 7, 9 ] );
} ## end sub get_file_key($ )

sub is_same_path($$ ) {
    my ( $left, $right ) = @_;
    return 1 if $left eq $right;
    my ( $left_key, $right_key ) = ( get_file_key( $left ), get_file_key( $right ) );
    if ( defined $left_key ) {
        if ( defined $right_key ) {
            return $left_key eq $right_key;
        }
        return undef;
    } ## end if ( defined $left_key)
    elsif ( defined $right_key ) {
        return undef;
    }
    else {
        ### Assume caseless filesystem
        return uc $left eq uc $right;
    }
} ## end sub is_same_path($$ )

sub is_different_path($$ ) {
    return !is_same_path( $_[ 0 ], $_[ 1 ] );
}

sub split_lines($ ) {
    my $contents = shift;
    return () unless defined $contents;
    return ( "" ) if $contents eq "";
    return ( split( /(?:\r\n?|\n)/, $contents, -1 ) );
} ## end sub split_lines($ )

END {
    my %db_up_cache = %database_update_cache;
    %database_update_cache = ();
    while ( my ( $database, $rec ) = each %db_up_cache ) {
        my ( $contents, $mtime, $verbose_name ) = @$rec;
        p_update_database_file( $database, $contents, $mtime, $verbose_name );
    }
} ## end END

1;
